Apple II Magazines (DO)/Nibble Volume 12, No. 05 (1991-05)(MindCraft Publishing)(Side B).zip/Nibble Volume 12, No. 05 (1991-05)(MindCraft Publishing)(Side B).do/PROFINDER.S2.txt

Text File | 1996-12-24 | 21KB | 738 lines

*********************************************
*               PROFINDER.S2                *
*       ProFinder source code, Part 2       *
*********************************************
* ---------------------------------
*   FILE UTILITY COMMAND HANDLERS
* ---------------------------------
* <S> Create Subdir command
M.CRDIR DCI 'Subdirectory name: '
CREATEDIR LDA #$40 ;If current dir pathname is
 CMP PN1L ;64 chars long, can't do this
 BEQ ERRORJ1
 PRINT M.CRDIR, ;Ask for subdir name
 JSR INPUTPN ;Input it
 BCS RTS1 ;Cancel command if <ESC> pressed
 JSR CROUT2
 MLI $C0,P.CRDIR, ;CREATE the subdirectory
 BCS ERRORJ1 ;Error exit
 BCC UPDIR ;Update current dir
*
* <K> Lock/Unlock command
LKUNLK JSR GETINFO ;Get file info
 BCS ERRORJ1
 LDA INFOACC
 EOR #%11000010 ;If Destroy, Rename, Write access bits
 BIT ACCBITS ;are set then it is Unlocked,
 BEQ LKUNLK1 ;so Lock it.
 ORA #%11000010 ;Otherwise it is Locked, so Unlock it
ACCBITS EQU *-1
LKUNLK1 ORA #%00000001 ;(Always set Read access bit)
 STA INFOACC
 JSR SETINFO ;Update file info
 BCC UPDIR ;Update current dir if successful
ERRORJ1 JMP ERROR ;Error exit
*
* <R> Rename command (for files)
RENAMEFIL JSR FINDSLASH
 STX PN1L ;Clear last filename in PN1
 PRINT M.RENAME, ;Ask for new name
 JSR INPUTPN ;Input it
 BCS RTS1 ;Cancel command if <ESC> pressed
 JSR CROUT2
 MLI $C2,P.RENAME,  ;RENAME (Old name in PN2, new in PN1)
 BCS ERRORJ1 ;Error
 BCC UPDIR ;Update dir
*
* <D> Delete command
M.DELETE DCI 'Delete this file'
DELETE PRINT M.DELETE, ;Ask if want to delete
 JSR YN ;Get "Y" or "N"
 BCS RTS1 ;If "N" then exit
 MLI $C1,P.DESTROY,  ;DESTROY the file
 BCS ERRORJ1
*
* UPDIR:  Update current directory by reading it again
*         Necessary when files in dir modified (renamed, locked, etc.)
UPDIR LDX #<PND
 JSR MOVPNX1 ;Fetch dir pathname
 JSR READDIR ; & read it
 BCS NEWDISK
RTS1 RTS
*
* <ESC> New Disk command, also called at START
NEWDISK LDX #0
 STX DIRLEVEL ;DIRLEVEL=0: in Volume Commands Menu
 STX MENUNUM
 LDA DIRSTACK ;Fetch choice no. of last disk drive used
 STA CHOICE ;Make it current choice
 LDY DEVCNT
 INY
 STY ACTIVEENT ;Put # of disk drives into ACTIVEENT
NDLOOP LDX MENUNUM ;For each disk drive,
 CPX ACTIVEENT ;identify slot & drive number
 BCS RTS1 ;and store in menu entry
 INX
 STX MENUNUM
 JSR CLEARMENU ;Clear menu entry of former info
 JSR GETUNITNO ;Get unit no. of disk drive
 TAX
 BMI ND1 ;unit no. negative means "drive 2"
 LDA #'1'
 BNE ND2
ND1 LDA #'2'
ND2 LDY #8 ;Store drive no. (1-2) in menu entry
 STA (MENUPTR),Y ;at Htab 8
 TXA
 LSR A ;Now get slot no. (1-7) from unit no.
 LSR A
 LSR A
 LSR A
 AND #$07
 ORA #'0' ;Convert slot no. to ASCII
 LDY #3
 STA (MENUPTR),Y ;Store slot no. at Htab 3
 JMP NDLOOP ;Go to next drive
*
* <B> Back Directory command
BACKDIR LDX DIRLEVEL ;If DIRLEVEL=1 then in root dir,
 CPX #2 ;so treat as <ESC> New Disk command
 BCC NEWDISK
 JSR GETINFO ;Make sure current dir is online
 BCS ERROR
 DEC PN1L ;Truncate the last dir filename
 JSR FINDSLASH ;from the whole pathname
 STX PN1L
 JSR READDIR ;Read parent directory
 BCS ERROR
 DEC DIRLEVEL ;If successful, get choice no. of the
 LDX DIRLEVEL ;dir just left from the directory stack
 LDA DIRSTACK,X ;so that the bar cursor will appear
 STA CHOICE ;on the DIR file user just left.
RTS2 RTS
*
* <P> Set Prefix command
SETPFX JSR MOVPN12 ;Set prefix to current dir
 MLI $C6,P.PREFIX,  ;SET_PREFIX
 BCC RTS2
*
* ERROR:  Display error message and wait for keypress
* Note:  WAITKEY, GETKEY, and UPCASE are called independently
ERROR JSR PRERR ;Print error message
WAITKEY PRINT M.WAITKEY, ;Ask for keypress
GETKEY STA STROBE ;Clear keyboard
 JSR RDKEY ;Get keypress
UPCASE AND #$7F
 CMP #'a' ;Convert to uppercase (with high bit off)
 BCC UPCASE1
 CMP #'z'+1
 BCS UPCASE1
 AND #$5F
UPCASE1 RTS
M.WAITKEY DCI 'Press any key.  '
* ------------------
*  <C> Copy command
* ------------------
COPY LDA #$82 ;Make sure active prefix exists,
 LDY PFXPTR ;or else report "NO PREFIX" error
 BEQ ERRORJ4
 JSR GETINFO ;Get info of file to be copied
 BCS ERRORJ4
 LDA #$4B
 DEX  ;Storage type must be 1, 2, or 3--Standard
 CPX #3 ;or else "FILE TYPE MISMATCH"
 BCS ERRORJ4
 JSR OPENPN2 ;Open source file
 BCS ERRORJ4
 MLI $D1,P.EOF, ;GET_EOF call, remember EOF of source file
 BCS ERRORC
 LDX #$FF ;SPARSE FILE DETECTOR TEST:
 CLC  ;Carry clear to subtract 1
COPY1 INX
 LDA #0 ;Zero ENDMARK to start reading at
 STA ENDMARK,X ;beginning of file
 LDA EOF,X
 SBC #0 ;Subtract 1 from EOF of file; store result
 STA MARK,X ;in MARK
 TXA
 EOR #2 ;EOR: Compare with 2 w/out changing Carry
 BNE COPY1
 BCC COPY2 ;If EOF=0 then seedling file
 LSR MARK+2
 ROR MARK+1 ;Calculate ((EOF - 1) / 512)
 LDY MARK+2 ;Y = (# index blocks - 1)
 BNE COPY3 ;If Y>0 then tree file
 LDA MARK+1 ;A = (# data blocks - 1)
 BEQ COPY2 ;If A=0 then seedling file
 CLC
 ADC #2 ;Sapling file: #blocks = (# data blks + 1)
 TAX
 BCC COPY4
 INY
 BCS COPY4
COPY2 LDX #1 ;Seedling file: #blocks = 1
 LDY #0
 BEQ COPY4
COPY3 TYA  ;Tree file: #blocks = (# data blks +
 CLC  ;                      # index blks + 1)
 ADC #3
 ADC MARK+1
 TAX
 BCC COPY4
 INY
COPY4 LDA #$84 ;Make sure #blocks file ACTUALLY has
 CPX INFOBLKS ;is same as #blocks file SHOULD have if
 BNE ERRORC ;it were sequential.  If not, then FILE IS
 CPY INFOBLKS+1 ;SPARSE and this program can't copy it.
 BEQ COPY5
ERRORC JSR CLOSEALL ;Close all before error exit
ERRORJ4 JMP ERROR ;Error exit
COPY5 JSR READHUNK ;OK to copy:  Read hunk of source file
 BCS ERRORJ4
 LDX #0
 LDA INFOTYP ;Make target file type different from
 BNE COPY6 ;source file type (temporarily) so they
 LDX #2 ;can be distinguished in case they should
COPY6 STX CRTYP ;have the same name.
 LDX #3
COPY7 LDA INFOCDAT,X ;Make target file have same created date
 STA CRCDAT,X ;as source file
 DEX
 BPL COPY7
 JSR FINDSLASH
 LDY #0 ;Copy filename to beginning of
COPY8 LDA PN1S,X ;PN1 with no slash in front of it,
 STA PN1S,Y ;so prefix will be used to locate
 INX  ;target file.
 INY  ;Default target filename will be same
 CPX PN1L ;as source filename.
 BCC COPY8
 STY PN1L
COPYA JSR HOME19
 PRINT M.COPY, ;Ask user for target filename
 JSR PRINT1
 JSR INPUTPN ;Get target filename (in PN1)
 BCC COPYA1
 RTS  ;Exit if user presses <ESC>
COPYA1 JSR CLCMD ;Clear command area at bottom of screen
 LSR F.SWAP ;Start by assuming user not swapping disks
 MLI $C0,P.CREATE,  ;CREATE the target file
 BCC COPYLOOP
 CMP #$47 ;If DUPLICATE FILE NAME error, print
 BEQ COPYA2 ;message and let user try again.
 BCS ERRORJ4 ;If any Path Not Found error, print
 CMP #$44 ;PREFIX NOT FOUND and let user try again.
 BCC ERRORJ4 ;Other errors: Don't try again.
 LDA #$83
COPYA2 JSR ERROR
 JMP COPYA
*
COPYLOOP JSR OPENPN1 ;Open target file
 BCS ABORT ;Abort copy if error
 JSR WRITEHUNK ;Write to target file
 BCS ABORT
 BIT F.EOF ;If EOF in source file reached while
 BMI COPYEND ;reading it, then finished copying.
 BIT F.SWAP
 BPL COPYL2 ;If user not swapping disks, skip:
COPYL1 PRINT M.INSRCE, ;Ask user to insert source disk
 JSR INSERTD ;Wait for user to insert disk
COPYL2 LDA #<PN2
 JSR CHECKFILE ;Check for source file online
 BVS ABORT ;Abort if critical error
 BCS COPYL1 ;Ask user again if source file not online
 LDA INFO2TYP ;Make sure we have source, not target
 CMP INFOTYP ;file: filetypes should match.
 BNE COPYL1
 JSR OPENPN2 ;Open source file
 BCS ABORT
 JSR READHUNK ;Read another hunk from it
 BCS ABORT
 BIT F.SWAP
 BPL COPYL4 ;If user not swapping disks, skip:
COPYL3 PRINT M.INTARG, ;Ask user to insert target disk
 JSR INSERTD ;Wait for user to insert disk
COPYL4 LDA #<PN1
 JSR CHECKFILE ;Check for target file online
 BVS ABORT ;Abort if critical error
 BCS COPYL3 ;Ask user again if target file not online
 LDA INFO2TYP ;Make sure we have target, not source
 CMP INFOTYP ;file: filetypes should differ
 BEQ COPYL3
 BNE COPYLOOP ;Repeat loop
*
COPYEND JSR SETINFO ;COPYEND: set file info of target file
 BCC RTS4 ;to file info of source file and exit.
ABORT JSR CLOSEALL ;ABORT: close all files,
 PHA  ;save error code,
 MLI $C1,P.DESTROY,  ;delete the incomplete target file,
 PLA  ;restore error code,
 JMP ERROR ;and exit through ERROR routine.
*
* Check if source or target file is online (specify which with A-reg)
CHECKFILE STA INFO2PN+1 ;Set up parm table
 LDA #$80 ;(Use P.INFO2 parm table to avoid
 STA INFO2PN ; overwriting P.INFO parm table)
 LDA #$A
 STA P.INFO2
 MLI $C4,P.INFO2, ;GET_FILE_INFO
 BCS CHECKF2
CHECKF1 CLV  ;No error: exit with C,V clear
 RTS
CHECKF2 CMP #$47 ;Path Not Found error ($44,$45,$46):
 BCS CHECKF3 ;exit with C set but V clear
 CMP #$44
 BCS CHECKF1
CHECKF3 BIT RTS4 ;Critical error (any error other than
RTS4 RTS  ;Path Not Found):  exit with V set.
*
* INSERTD:  Wait for user to insert disk
*   Note:  CLCMD, VTAB19, VTABLINE, HOME19 called independently
INSERTD SEC  ;Assume user is swapping disks (because
 ROR F.SWAP ;user had to be asked to insert right
 JSR WAITKEY ;disk at least once) and Wait for user.
CLCMD JSR VTAB19 ;CLCMD: Clear cmd area at bottom of screen
 LDX #165 ;except for "target filename:" info on
 JSR PRBL2 ;bottom line; done by printing 165 spaces.
VTAB19 LDA #19 ;VTAB19: Vtab to line 19 and Htab 0.
VTABLINE LDY #0 ;VTABLINE: Vtab to A-reg and Htab 0.
 STY CH
 JMP TABV
HOME19 JSR VTAB19 ;HOME19: Clear from line 19 to bottom;
 JMP CLEOP ;this region used as command area.
*
M.COPY ASC 'Copying file to Prefix--'
 DFB CR,CR
M.INTARG ASC 'Insert target disk.'
 DFB CR,CR+$80
 DCI 'Enter target filename: '
M.INSRCE ASC 'Insert source disk.'
 DFB CR,CR+$80
*
* Read a hunk of the source file
READHUNK LDA MEMLO ;All of the memory from MEMLO to MEMHI
 STA RWDATA ;is available for copying, so start
 LDA MEMLO+1 ;reading at MEMLO and
 STA RWDATA+1 ;read (MEMHI-MEMLO) bytes.
 SEC
 LDA MEMHI
 SBC MEMLO
 STA RWCOUNT
 LDA MEMHI+1
 SBC MEMLO+1
 STA RWCOUNT+1
 LDX #2
RH1 LDA ENDMARK,X ;Start reading within file at ENDMARK
 STA MARK,X ;where last read ended.  If this is first
 STA STARTMARK,X ;time read, then ENDMARK should be zeroed.
 DEX
 BPL RH1
 MLI $CE,P.MARK, ;SET_MARK
 BCS CLOSEJ2
 JSR READ ;Now read it
 BCS CLOSEJ2
 MLI $CF,P.MARK, ;GET_MARK to update MARK
 BCS CLOSEJ2
 SEC
 ROR F.EOF
 LDX #2
RH2 LDA MARK,X ;Move new MARK to ENDMARK for next read.
 STA ENDMARK,X
 CMP EOF,X ;If MARK <> EOF, then clear F.EOF flag
 BEQ RH3 ;to indicate not all of file has been read
 LSR F.EOF ;yet.  Otherwise leave F.EOF flag set.
RH3 DEX
 BPL RH2
 CLC
CLOSEJ2 JMP CLOSEALL ;Exit via close.
*
* Write a hunk to target file
WRITEHUNK LDA RWTRANS ;Write same # of bytes that was read
 STA RWCOUNT ;during last READHUNK call.
 LDA RWTRANS+1
 STA RWCOUNT+1
 LDX #2
WH1 LDA STARTMARK,X ;Start writing within file at
 STA MARK,X ;STARTMARK, where last read started.
 DEX
 BPL WH1
 MLI $CE,P.MARK, ;SET_MARK
 BCS CLOSEJ1
 MLI $CB,P.RW, ;WRITE
 BCS CLOSEJ1
 MLI $CC,P.CLOSE, ;CLOSE file specifically to detect errors
CLOSEJ1 JMP CLOSEALL ;then exit via CLOSEALL.
* -------------------
*   READ DIRECTORY     Input: directory pathname in PN1
* -------------------  Output: file catalog info in menu entries
READDIR JSR FINDSLASH
 CPX PN1L ;If directory pathname doesn't
 BEQ RD1 ;already end in a "/", then
 LDX PN1L ;put a "/" at the end of it.
 LDA #'/'
 STA PN1S,X
 INC PN1L
RD1 JSR OPENPN1 ;Open dir file
 BCS RTS3
 LDA #0
 STA RWDATA ;Read entire directory file all at once
 STA RWCOUNT ;beginning at DIRLOAD
 LDA #<DIRLOAD ;up to MAXDIRSIZ bytes.
 STA RWDATA+1 ;(MAXDIRSIZ sufficient to read very
 LDA #<MAXDIRSIZ ; large directories)
 STA RWCOUNT+1
 JSR READ ;Read it
 JSR CLOSEALL
 BCS RTS3 ;Error exit
 LDX #<PND
 JSR MOVPN1X ;Move dir pathname to PND
 LDX #0
 STX ACTIVEENT ;Initialize ACTIVEENT to 0
 LSR RWTRANS+1 ;(RWTRANS / 512) = # blocks of dir read
 LDA FILECOUNT+1
 BEQ RD2 ;If more than 255 files in dir,
 LDA #$FF ;truncate at 255 (that's all MENU routine
 STA FILECOUNT ;can handle anyway).
RD2 JSR GETBLOCK ;Set Entry Pointer (ENTPTR) to first
 BMI RDEND ;dir block.
 JSR NEXTENT ;Skip dir header.
RDLOOP LDX ACTIVEENT
 CPX FILECOUNT ;If file count reached, end
 BEQ RDEND
 LDY #0
 LDA (ENTPTR),Y ;Get length of filename of an entry
 AND #$0F
 BEQ RD3 ;Length = 0: inactive entry, skip it
 INX
 STX ACTIVEENT ;Add 1 to count of active entries
 STA T.NAMELEN,X ;Save filename length in table
 JSR CATENTRY ;Create catalog info for menu display
RD3 LDA BLKENT
 CMP ENTPERBLK ;End of one dir block?
 BCS RD4
 JSR NEXTENT ;No, go to next entry in same block
 JMP RDLOOP
RD4 JSR GETBLOCK ;Yes, go to next block
 BPL RDLOOP ;Continue unless out of blocks.
RDEND LDX ACTIVEENT ;End of dir read:
 JSR SETPTR ;Set MEMHI to last entry (stored lowest in
 STA MEMHI ;memory) so COPY command won't overwrite
 STY MEMHI+1 ;menu entries.
 CLC  ;Carry clear indicates no error
RTS3 RTS
*
SETPTR INX  ;SETPTR: Sets up MENUPTR to a menu entry.
 LDA #0 ; Call with X-reg = menu entry number
 LDY #$BF
 BNE SETPTR2 ;Menu entries start at $BF00 and go down
SETPTR1 SEC
 SBC #39 ;Each entry takes up 39 bytes
 BCS SETPTR2
 DEY
SETPTR2 DEX  ;Formula:
 BNE SETPTR1 ; MENUPTR = $BF00 - (39 * Entry no.)
 STA MENUPTR
 STY MENUPTR+1
 RTS
*
GETBLOCK DEC RWTRANS+1 ;Get next block in dir
 BMI GETBLOCK1 ;(RWTRANS+1 counts #blocks left)
 LDA #4
 STA ENTPTR ;Point to first entry in block at byte #4
 LDX RWDATA+1 ;(RWDATA+1 points to where block stored)
 STX ENTPTR+1
 INX  ;Increment RWDATA+1 pointer by $200 bytes
 INX  ;to point to the next block in memory
 STX RWDATA+1
 LDA #1 ;Ready for first entry in block
 STA BLKENT ;Exit with N-flag clear if got a block
GETBLOCK1 RTS  ;Exit with N-flag set if no blocks left
*
NEXTENT INC BLKENT ;Go to next entry within same block
 LDA ENTLEN
 CLC  ;Increment entry pointer by entry length
 ADC ENTPTR ;parameter given in dir header.
 STA ENTPTR
 BCC NEXTENT1
 INC ENTPTR+1 ;Ready for next entry in block
NEXTENT1 RTS
*
CATENTRY PHA  ;Create catalog info for a menu entry
 JSR CLEARMENU ;(Call with filename length in A-reg,
 PLA  ; ENTPTR set up, and menu entry no. in
 TAY  ; X-reg.)
CAT1 LDA (ENTPTR),Y ;Move filename from directory block entry
 STA (MENUPTR),Y ;to menu entry.
 DEY
 BNE CAT1
 LDY #$1E
 LDA (ENTPTR),Y ;Get access code from dir block entry
 AND #%11000010
 CMP #%11000010 ;If any of Write, Rename, Destroy access
 BEQ CAT2 ;bits not set, then file is Locked
 LDA #'*' ;so store an asterisk in front of filename
 LDY #0 ;in menu entry
 STA (MENUPTR),Y
CAT2 LDY #$10
 LDA (ENTPTR),Y ;Get file type code
 LDY #18 ;(Put file type at Htab 18 on screen)
 LDX #NFITYPES-1
CAT3 CMP FITYPES,X ;Compare file type with list of
 BEQ CAT4 ;known file types
 DEX
 BPL CAT3
 TAX
 LDA #'$' ;If unknown file type, then
 STA (MENUPTR),Y ;file type code is "$xx"
 TXA
 LSR A
 LSR A
 LSR A
 LSR A
 JSR STORENIB ;Store file type code in hex
 TXA
 JSR STORENIB
 JMP CAT5
CAT4 LDA FITYPES1,X ;If known file type, store its
 STA (MENUPTR),Y ;three-letter abbreviation in menu entry
 INY
 LDA FITYPES2,X
 STA (MENUPTR),Y
 INY
 LDA FITYPES3,X
 STA (MENUPTR),Y
CAT5 LDY #$21 ;Get modified date
 LDA (ENTPTR),Y
 BEQ CAT7 ;If no date, skip
 PHA
 AND #$1F ;Isolate day of month
 TAX
 INY
 LDA (ENTPTR),Y ;Save second byte of mod. date
 STA TEMP
 JSR DEC1B ;Convert day to decimal
 LDY #30
 LDX #3
 JSR PUTNUMX ;Store day (Htab 30) in menu entry
 PLA
 LSR TEMP
 ROR A ;Isolate month
 LSR A
 LSR A
 LSR A
 LSR A
 TAX
 DEX
 LDA #'-' ;Store "-"s between Day-Month-Year
 LDY #36
 STA (MENUPTR),Y
 LDY #32
 STA (MENUPTR),Y
 INY
 CPX #12
 BCS CAT6
 LDA MONTHS1,X ;Store month abbreviation
 STA (MENUPTR),Y
 INY
 LDA MONTHS2,X
 STA (MENUPTR),Y
 INY
 LDA MONTHS3,X
 STA (MENUPTR),Y
CAT6 LDA TEMP ;Isolate year
 CLC
 ADC #100 ;Add 100 for leading zero
 TAX
 JSR DEC1B ;Convert to decimal
 LDY #37
 LDX #3
 JSR PUTNUMX ;Store year (Htab 37)
CAT7 LDY #$13
 LDA (ENTPTR),Y ;Get # blocks used
 TAX
 INY
 LDA (ENTPTR),Y
 JSR DEC ;Convert to decimal
 LDY #23 ;Store #blocks used at Htab 23
PUTNUM LDX #0 ;PUTNUM:  called independently, it
PUTNUMX LDA NUMBER,X ; moves decimal number from NUMBER to
 STA (MENUPTR),Y ; menu entry at Htab (Y-reg).
 INY
 INX
 CPX #5
 BNE PUTNUMX
 RTS
*
FITYPES DFB 1,4,6,8,$F,$19,$1A,$1B     ;Standard & AplWks file types
 DFB $B0,$B1,$B2,$B3,$B4,$B5,$B6,$B7    ;ProDOS 16 file types
 DFB $B8,$B9,$BA,$BB,$BF,$C0,$C1,$C8,$E2     ;More P16 types
 DFB $EF,$F0,$F9,$FA,$FB,$FC,$FD,$FE,$FF     ;ProDOS 8 types
 DFB $A0,$A1,$A2,$A3,$A4        ;WordPerfect file types
NFITYPES EQU *-FITYPES
FITYPES1 ASC 'BTBFDAAASOLSRESTNCTDDPPFDPCPIIBVRSWMHDV'  ;File type
FITYPES2 ASC 'AXIOIDWSRBI1TXTSDDORONIOTAM1NVAAEYPALAR'  ;codes.  Read
FITYPES3 ASC 'DTNTRBPPCJB6LERFAALVCTCNSSD6TRSRLS CPTT'  ;vertically.
MONTHS1 ASC 'JFMAMJJASOND'  ;Month names.
MONTHS2 ASC 'AEAPAUUUECOE'  ;Read them vertically.
MONTHS3 ASC 'NBRRYNLGPTVC'
*
DEC1B LDA #0 ;DEC1B: Convert 1-byte no. in X to decimal
DEC STX VAL ;DEC: Convert 2-byte number to decimal
 STA VAL+1 ; Call with value in (X low, A high)
 LDX #0 ; Result stored (Ascii form) in NUMBER
 LDA #SPACE
DEC1 STA NUMBER,X ;Fill NUMBER string with spaces first
 INX
 CPX #5
 BNE DEC1
DEC2 DEX  ;Digit counter in X-reg
 LDA #0 ;(X=4: on ones digit;  X=0: 10000's dig)
 STA AUX
 LDY #16 ;For 16-bit number, rotate it 16 times
DEC3 ASL VAL
 ROL VAL+1 ;Rotate the value left 1 bit at a time
 ROL AUX ;and accumulate what comes out left side
 LDA AUX ;in AUX.  Whenever 10 or more comes out
 SEC  ;the left side into AUX, push 1 back into
 SBC #10 ;the right side of VAL and subtract 10
 BCC DEC4 ;from AUX, so that we divide by 10 while
 INC VAL ;rotating.
 STA AUX
DEC4 DEY
 BNE DEC3
 LDA AUX ;What's left in AUX after 16 rotations
 ORA #'0' ;is remainder after dividing VAL by ten.
 STA NUMBER,X ;Convert it to ASCII digit & store it
 LDA VAL ;in NUMBER.
 ORA VAL+1 ;If VAL not zero then go
 BNE DEC2 ;to the next higher digit (decimal place).
 RTS  ;Otherwise done.
*
STORENIB AND #$0F ;Convert nibble in lower 4 bits of A-reg
 CMP #$0A ;to a hex digit and store it in menu entry
 BCC STORENIB1
 ADC #6
STORENIB1 ADC #'0'
 INY
 STA (MENUPTR),Y
 RTS
*
CLEARMENU JSR SETPTR ;Find menu entry and fill all 39
 LDY #38 ;bytes of it with spaces to
 LDA #SPACE ;erase old info.  Call with menu entry
CLEAR1 STA (MENUPTR),Y ;no. in X-reg.
 DEY
 BPL CLEAR1
 RTS
*
* INPUTPN:  Input filename from user.  Call with complete pathname
*           in PN1; user will be allowed to modify last filename.
*   Output: Carry clear = user pressed <RETURN>;  Carry set = <ESC>
INPUTPN JSR FINDSLASH ;Isolate last filename in the pathname
 STX STARTPOS ;STARTPOS = position within pathname
 TXA  ; where last filename starts
 CLC
 ADC #$F ;Allow for 15-char filename
 CMP #$40 ;OR 64-char pathname, whichever smaller
 BCC INPUT1
 LDA #$40
INPUT1 STA ENDPOS ;ENDPOS = Max length user can enter
 LDA CH
 STA TEMP ;Save screen cursor position
 JSR PRPN1X ;Print the default filename
 LDA TEMP
 STA CH ;Recall screen cursor position to start
 LDX STARTPOS
INLOOP JSR GETKEY ;Get keypress
 CMP #CR ;If <RETURN> pressed, exit w/Carry clear
 BNE IN1 ;However, <RETURN> not acceptable if
 LDA STARTPOS ;no filename entered & no default
 CMP PN1L ;filename used.
 BEQ INLOOP
 CLC
 RTS
IN1 CPX STARTPOS ;If cursor pos is at 1st char of filename,
 BNE IN2 ;then only accept <A-Z> input,
 CMP #ESC ;or <ESC> to cancel (return w/Carry set).
 BNE INCHAR1
 SEC
 RTS
IN2 CMP #ESC ;If cursor beyond 1st char of filename,
 BNE IN3 ;then <ESC> starts input over again.
 LDA TEMP
 STA CH
 LDX STARTPOS
 JMP PUTCHAR2
IN3 CMP #DEL ;Check for Delete key.
 BNE IN4
 LDA #LARROW ;Delete key treated as Left Arrow.
IN4 CMP #LARROW ;Check for Left Arrow.
 BNE INCHAR
 DEX  ;If Left Arrow, go back 1 char.
 JMP PUTCHAR1
INCHAR CMP #'.' ;Acceptable characters are
 BEQ PUTCHAR ;periods, letters, and digits.
 CMP #'0'
 BCC INLOOP
 CMP #'9'+1
 BCC PUTCHAR
INCHAR1 CMP #'A'
 BCC INLOOP
 CMP #'Z'+1
 BCS INLOOP
PUTCHAR CPX ENDPOS ;If at end position (max length that can
 BEQ INLOOP ;be allowed) then don't accept any more.
 STA PN1S,X ;Store ASCII character in PN1.
 INX  ;Increment cursor position.
PUTCHAR1 ORA #$80
 JSR COUT ;Print to screen.
PUTCHAR2 STX PN1L ;Truncate everything after cursor: set
 JSR CLEOL ; new PN1 length & clear rest of line.
 JMP INLOOP ;Get another char.
*
PRPN1 LDX #0 ;Print Pathname 1:
PRPN1X CPX PN1L ;Call PRPN1 to print all of PN1
 BCS RTS5 ;Call PRPN1X to print portion of PN1
 LDA PN1S,X ; following X-reg.
 ORA #$80
 JSR COUT
 INX
 JMP PRPN1X
*
* Ask user a Yes/No question.
*  Output:  Carry clear if user responds "Y"; set if "N" or <ESC>
YN PRINT M.YN
YN1 JSR GETKEY ;Get keypress
 CMP #ESC ;If <ESC>, exit with carry set.
 BEQ RTS5
 CMP #'Y'
 BEQ YN2
 CMP #'N' ;If "N", exit with carry set.
 BNE YN1
RTS5 RTS
YN2 ORA #$80 ;If "Y",
 JSR COUT ;print the "Y",
 JSR CROUT2 ;print 2 CR's,
 CLC  ;and return with carry clear.
 RTS
M.YN DCI '?  (Y/N):  '
*
* Find last slash "/" in PN1
*  Output:  X = position of char after last slash
FINDSLASH LDX PN1L ;Start searching at end and
FINDSL1 DEX  ;move backwards.
 BMI FINDSL2 ;If no "/"s found then return X = 0
 LDA PN1S,X
 EOR #'/' ;Test for "/" (high bit immaterial)
 ASL A
 BNE FINDSL1
FINDSL2 INX  ;Found it.
 RTS
*
CHKPOINT2 DFB $EF ;Checkpoint 2 must contain $EF
*
* NOTE:  PROGRAM COUNTER MAY NOT EXCEED $1F00 AT THIS POINT
*
 DS $1F00-*,0 ;FILL WITH ZEROS UP TO $1F00.
* Finished.